home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / Directories.Mod (.txt) < prev    next >
Oberon Text  |  1996-05-29  |  14KB  |  396 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. ParcElems
  4. Alloc
  5. Syntax10b.Scn.Fnt
  6. Syntax8i.Scn.Fnt
  7. FoldElems
  8. MarkElems
  9. Alloc
  10. MODULE Directories;    (* CS 10.10.95 based on Windows-FileDir from MH Feb 93 / 2.6.94 and PowerMac-Directories from HM Oct 95 *)
  11. IMPORT
  12.     (*SYSTEM,*) TextFrames, O:=Console, Out, Files, AmigaDos, Strings; (*,Unix,directory*)
  13. CONST
  14.     noErr* = 0;    (**no error*)
  15.     badName* = 1;    (**bad file or directory name*)
  16.     mediumFull* = 2;    (**disk or directory full*)
  17.     mediumLocked* = 3;    (**hardware or software lock*)
  18.     dirInUse* = 4;    (**directory in use or not empty*)
  19.     notADir* = 5;    (**name does not specify a directory*)
  20.     alreadyExists* = 6;    (**directory already exists*)
  21.     otherError* = 7;    (**other OS-specific error*)
  22.     delete* = 0; insert* = 1;  change* = 2;     (** notify operations **)
  23.     delimiter* = "/";    (** delimiter in path names **)
  24.     Directory* = POINTER TO DirectoryDesc;
  25.     Entry* = POINTER TO EntryDesc;
  26.     DirectoryDesc* = RECORD
  27.         path*: ARRAY 256 OF CHAR;
  28.     END;
  29.     EntryDesc* = RECORD
  30.         dir*: Directory;
  31.         name*: ARRAY 32 OF CHAR;
  32.         hostname*: ARRAY 14 OF CHAR
  33.     END;
  34.     FileProc* = PROCEDURE (d: Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN);
  35.     PathProc* = PROCEDURE (path: ARRAY OF CHAR; VAR continue: BOOLEAN);
  36.     Notifier* = PROCEDURE (op: INTEGER; path, name: ARRAY OF CHAR);
  37.     FileInfoBlockPtr=POINTER TO AmigaDos.FileInfoBlock;
  38. (*    Directories = POINTER TO ARRAY OF Directory;*)
  39.     res*: INTEGER;
  40.     notify*: Notifier;
  41.     dirTab: POINTER TO ARRAY OF Directory;
  42.     startupPath: ARRAY 256 OF CHAR;    (*path containing the Oberon application*)
  43.     nofPaths: INTEGER;
  44.     CurrentDir: Directory;
  45. PROCEDURE 
  46. AppendFile (VAR path: ARRAY OF CHAR; filename: ARRAY OF CHAR);
  47.     VAR i, j, max: LONGINT;
  48. BEGIN
  49.     i := 0; j := 0; max := LEN(path)-1;
  50.     WHILE path[i] # 0X DO INC(i) END ;
  51.     IF (i > 0) & (path[i-1] # delimiter) THEN path[i] := delimiter; INC(i) END ;
  52.     WHILE (i < max) & (filename[j] # 0X) DO path[i] := filename[j]; INC(i); INC(j) END ;
  53.     path[i] := 0X;
  54. END AppendFile;
  55. PROCEDURE 
  56. InsertEntry* (D: Directory; e: Entry);
  57. BEGIN
  58.     (* No meaning under Unix. *)
  59. END InsertEntry;
  60. PROCEDURE 
  61. RemoveEntry* (e: Entry);
  62. BEGIN
  63.     (* No meaning under Unix. *)
  64. END RemoveEntry;
  65. PROCEDURE 
  66. ThisEntry* (D: Directory; VAR name: ARRAY OF CHAR): Entry;
  67. BEGIN
  68.     RETURN NIL;
  69. END ThisEntry;
  70. PROCEDURE 
  71. ThisHostEntry* (D: Directory; VAR hostname: ARRAY OF CHAR): Entry;
  72. BEGIN
  73.     RETURN NIL;
  74. END ThisHostEntry;
  75. PROCEDURE 
  76. ExpandPath (this: ARRAY OF CHAR; VAR absPath: ARRAY OF CHAR);
  77.     current:ARRAY 256 OF CHAR;
  78.     pwd:ARRAY 256 OF CHAR;
  79.     fib : FileInfoBlockPtr;
  80.     lock: AmigaDos.FileLockPtr;
  81. BEGIN
  82.     IF AmigaDos.GetCurrentDirName(current, LEN(current)) THEN
  83.         COPY(this, absPath);
  84.         IF AmigaDos.SetCurrentDirName(absPath) THEN
  85.             IF AmigaDos.GetCurrentDirName(pwd, LEN(pwd)) THEN 
  86.                 COPY(pwd, absPath); 
  87.                 (* Now we have to check wether this really is a directory. SetCurrentDir() even works with Files!  <<FF *)
  88.                 lock := AmigaDos.Lock(absPath, AmigaDos.sharedLock);
  89.                 IF lock#0 THEN
  90.                     NEW(fib);
  91.                     IF AmigaDos.NameFromLock(lock, absPath) THEN END;
  92.                     IF AmigaDos.Examine(lock, fib^) THEN
  93.                         IF fib.dirEntryType<0 THEN 
  94.                             absPath[0] := 0X; 
  95.                         END;
  96.                     END;
  97.                     AmigaDos.UnLock(lock);
  98.                     fib := NIL;
  99.                 ELSE
  100.                     absPath[0] := 0X; (* couldn't lock dir/file *)
  101.                 END;
  102.             ELSE
  103.                 absPath[0] := 0X;
  104.             END;
  105.             IF AmigaDos.SetCurrentDirName(current) THEN END;
  106.         ELSE
  107.             absPath[0] := 0X;
  108.         END;
  109.     ELSE
  110.         absPath[0] := 0X;                
  111.     END;
  112. END ExpandPath;
  113. PROCEDURE 
  114. OpenDirectory (VAR absPath: ARRAY OF CHAR; VAR D: Directory);
  115. BEGIN
  116.     ExpandPath(absPath,absPath);
  117.     IF absPath="" THEN
  118.         D:=NIL;
  119.     ELSE
  120.         NEW(D);
  121.         COPY(absPath,D.path);
  122.     END;
  123. END OpenDirectory;
  124. PROCEDURE 
  125. Map* (name: ARRAY OF CHAR; VAR hostname: ARRAY OF CHAR);
  126. BEGIN
  127.     COPY(name,hostname);
  128. END Map;
  129. PROCEDURE 
  130. NextMapping* (VAR name: ARRAY OF CHAR);
  131. BEGIN
  132.     (* No meaning under Unix. *)
  133. END NextMapping;
  134. PROCEDURE 
  135. Exists* (dir: Directory; VAR hostname: ARRAY OF CHAR): BOOLEAN;
  136.     done:BOOLEAN;
  137.     fullname:ARRAY 256 OF CHAR;
  138.     lock: AmigaDos.FileLockPtr;
  139. BEGIN
  140.     COPY(dir.path,fullname);
  141.     AppendFile(fullname,hostname);
  142.     lock := AmigaDos.Lock(fullname, AmigaDos.sharedLock);
  143.     IF lock#0 THEN
  144.         AmigaDos.UnLock(lock);
  145.         RETURN TRUE;
  146.     END;
  147.     RETURN FALSE;
  148. END Exists;
  149. PROCEDURE 
  150. This*(path: ARRAY OF CHAR):Directory;
  151.     D:Directory; 
  152.     absPath:ARRAY 256 OF CHAR;
  153. BEGIN
  154.     ExpandPath(path,absPath);
  155.     IF absPath="" THEN RETURN NIL END ;
  156.     OpenDirectory(absPath,D);
  157.     RETURN D;
  158. END This;
  159. PROCEDURE 
  160. RenameEntry* (e: Entry; VAR new: ARRAY OF CHAR);
  161.     name1, name2: ARRAY 256 OF CHAR;
  162. BEGIN
  163.     COPY(e.dir.path, name1);
  164.     AppendFile(name1, e.name);
  165.     COPY(e.dir.path, name2);
  166.     AppendFile(name2, new);
  167.     IF AmigaDos.Rename(name1, name2) THEN END;
  168.     (* Files.Rename ! *)
  169.     oldName,newName:ARRAY 32 OF CHAR;
  170. BEGIN
  171.     COPY(e.dir.path, oldName);
  172.     COPY(e.dir.path, newName);
  173.     AppendFile(oldName, e.name);
  174.     AppendFile(newName, new);
  175.     res := otherError;
  176.     Files.Rename(oldName, newName, res);
  177.     IF res = 0 THEN
  178.         notify(delete, e.dir.path, e.name);
  179.         COPY(new, e.name);
  180.         notify(insert, e.dir.path, e.name);
  181.         res := noErr;
  182.     ELSE
  183.         res := otherError;
  184.     END;    
  185.     res:=otherError;
  186. END RenameEntry;
  187. PROCEDURE 
  188. DeleteFile* (dir: Directory; VAR name: ARRAY OF CHAR);
  189.     fullname: ARRAY 256 OF CHAR;
  190. BEGIN
  191.     COPY(dir.path,fullname); AppendFile(fullname,name);
  192.     Files.Delete(fullname,res);
  193. END DeleteFile;
  194. PROCEDURE 
  195. GetHostname* (name: ARRAY OF CHAR; VAR hostname: ARRAY OF CHAR);
  196. BEGIN
  197.     COPY(name, hostname);
  198. END GetHostname;
  199. PROCEDURE 
  200. Enumerate* (D: Directory; H: FileProc);
  201.     fib: FileInfoBlockPtr;
  202.     lock: AmigaDos.FileLockPtr;
  203.     continue: BOOLEAN;
  204.     PROCEDURE CheckDigit(ch: CHAR): BOOLEAN;
  205.     BEGIN    RETURN (ch=".") OR ((ch>="0") & (ch<="9"));
  206.     END CheckDigit;
  207.     PROCEDURE CheckChar(ch: CHAR): BOOLEAN;
  208.     BEGIN    RETURN CheckDigit(ch) OR ((ch>="A") & (ch<="Z")) OR ((ch>="a") & (ch<="z"));
  209.     END CheckChar;
  210.     PROCEDURE CheckName(name: ARRAY OF CHAR): BOOLEAN;
  211.         i: INTEGER;
  212.     BEGIN
  213.         IF CheckDigit(name[0]) THEN RETURN TRUE END;
  214.         WHILE name[i]#0X DO
  215.             IF ~CheckChar(name[i]) THEN RETURN TRUE END;
  216.             INC(i);
  217.         END;
  218.         RETURN FALSE; 
  219.     END CheckName;
  220. BEGIN
  221.     lock := AmigaDos.Lock(D.path,AmigaDos.sharedLock);
  222.     IF lock#0 THEN
  223.         NEW(fib);
  224.         IF AmigaDos.Examine(lock, fib^) THEN
  225.             continue := TRUE;
  226.             LOOP
  227.                 IF AmigaDos.ExNext(lock,fib^) THEN
  228.                     (* Check wether there are illegal characters in the filename <<FF *)
  229.                     IF ~CheckName(fib.fileName) THEN H(D, fib.fileName, fib.dirEntryType>0, continue) END;
  230.                     IF ~continue THEN EXIT END;
  231.                 ELSE
  232.                     IF AmigaDos.IoErr()=232 THEN EXIT END;  (* Check for NO_MORE_ENTRIES *)
  233.                 END;        
  234.             END;
  235.         END;
  236.         AmigaDos.UnLock(lock);
  237.         fib := NIL;
  238.     END;    
  239. END Enumerate;
  240. PROCEDURE 
  241. Current*():Directory;
  242.     current:ARRAY 256 OF CHAR;
  243. BEGIN
  244.     IF AmigaDos.GetCurrentDirName(current, LEN(current)) THEN END;
  245.     CurrentDir:=This(current);
  246.     RETURN CurrentDir;
  247. END Current;
  248. PROCEDURE 
  249. Change*(path:ARRAY OF CHAR);
  250.     D:Directory;
  251.     rc:LONGINT;
  252.     res: INTEGER;
  253.     buf: ARRAY 256 OF CHAR;
  254. BEGIN
  255.     D:=This(path);
  256.     IF D#NIL THEN
  257.         Files.ChangeDirectory(path, res);
  258.         IF res=0 THEN
  259.         (*IF AmigaDos.SetCurrentDirName(path) THEN*)
  260.             res:=noErr;
  261.             CurrentDir:=D;
  262.             notify(change,"","")
  263.         ELSE (* Try to change relative to startup path *)     (*<<FF 29.6.96*)
  264.             COPY(startupPath, buf);
  265.             AppendFile(buf, path);
  266.             D := This(buf);
  267.             Files.ChangeDirectory(buf, res);
  268.             IF res=0 THEN
  269.                 res := noErr;
  270.                 CurrentDir := D;
  271.                 notify(change,"","");
  272.             ELSE
  273.                 res := otherError;
  274.             END;                
  275.         END
  276.     ELSE
  277. END Change;
  278. PROCEDURE 
  279.  Startup* (): Directory;
  280. BEGIN
  281.     RETURN This(startupPath)
  282. END Startup;
  283. PROCEDURE 
  284. Split (path: ARRAY OF CHAR; VAR path0, dirName: ARRAY OF CHAR);
  285.     VAR i, j: INTEGER;
  286. BEGIN
  287.     i := 0; j := 0;
  288.     WHILE path[i] # 0X DO
  289.         path0[i] := path[i];
  290.         IF path[i] = delimiter THEN j := i END ;
  291.         INC(i)
  292.     END ;
  293.     path0[j] := 0X; INC(j); i := 0;
  294.     WHILE path[j] # 0X DO
  295.         dirName[i] := path[j];
  296.         INC(i); INC(j)
  297.     END ;
  298.     dirName[i] := 0X
  299. END Split;
  300. PROCEDURE 
  301. Create* (path: ARRAY OF CHAR);
  302.     absPath: ARRAY 256 OF CHAR;
  303.     dirName: ARRAY 32 OF CHAR;
  304.     lock: AmigaDos.FileLockPtr;
  305.     done:BOOLEAN;
  306. BEGIN
  307.     COPY(path,absPath);
  308.     lock :=  AmigaDos.CreateDir(absPath);
  309.     IF lock#0 THEN
  310.         AmigaDos.UnLock(lock);
  311.         ExpandPath(absPath,absPath);
  312.         Split(absPath, path,dirName);
  313.         notify(insert,path,dirName);
  314.         res:=noErr;
  315.     ELSE
  316.         res:=otherError;
  317. END Create;
  318. PROCEDURE 
  319. Delete* (path: ARRAY OF CHAR);
  320.     VAR absPath: ARRAY 256 OF CHAR; dirName: ARRAY 32 OF CHAR;
  321. BEGIN
  322.     ExpandPath(path,absPath);
  323.     Files.Delete(absPath,res);
  324.     IF res=0 THEN
  325.         Split(absPath,path,dirName);
  326.         notify(delete,path,dirName);
  327.         res:=noErr;
  328.     ELSE
  329.         res:=otherError;
  330. END Delete;
  331. PROCEDURE 
  332. Rename* (oldPath, newPath: ARRAY OF CHAR);
  333.     oldPath0,newPath0:ARRAY 256 OF CHAR;
  334.     oldName,newName:ARRAY 32 OF CHAR;
  335. BEGIN
  336.     res:=otherError;
  337.     ExpandPath(oldPath,oldPath0);
  338.     IF oldPath0[0]#0X THEN
  339.         COPY(newPath,newPath0);
  340.         Files.Rename(oldPath0,newPath0,res);
  341.         IF res=0 THEN
  342.             Split(oldPath0,oldPath,oldName);
  343.             notify(delete,oldPath,oldName);
  344.             ExpandPath(newPath0,newPath0);
  345.             Split(newPath0,newPath,newName);
  346.             notify(insert,newPath,newName);
  347.             res:=noErr;
  348.         ELSE
  349.             res:=otherError;
  350.         END
  351. END Rename;
  352. PROCEDURE 
  353. EnumeratePaths* (proc: PathProc);
  354.     VAR pathNo: LONGINT; continue: BOOLEAN; dir: Directory;
  355. BEGIN
  356.     pathNo := 0; continue := TRUE;
  357.     WHILE continue & (pathNo < nofPaths) DO
  358.         dir:=dirTab[pathNo];
  359.         proc(dir.path, continue);
  360.         INC(pathNo)
  361. END EnumeratePaths;
  362. PROCEDURE 
  363. InitDirectories;
  364.     dirCnt: INTEGER;
  365.     buf: ARRAY 256 OF CHAR;
  366.     file: AmigaDos.FileLockPtr;
  367. BEGIN
  368.     file := AmigaDos.Open("Oberon4Amiga:Paths", AmigaDos.oldFile);    (* Open configuration file *)
  369.     IF file#0 THEN
  370.         WHILE AmigaDos.FGets(file, buf, LEN(buf))#0 DO                        (* Read the number of Paths *)
  371.             IF buf[0]#";" THEN INC(nofPaths) END;                                    (* ignore comment lines *)
  372.         END;
  373.         NEW(dirTab, nofPaths);                                                            (* allocate path table *)
  374.         IF AmigaDos.Seek(file, 0, AmigaDos.beginning)#0 THEN END;        (* Move to beginning of file *)
  375.         WHILE AmigaDos.FGets(file, buf, LEN(buf))#0 DO                        (* Read in the path lines *)
  376.             IF buf[0]#";" THEN 
  377.                 NEW(dirTab[dirCnt]);
  378.                 COPY(buf, dirTab[dirCnt].path);
  379.                 INC(dirCnt);
  380.             END;
  381.         END;
  382.         IF AmigaDos.Close(file) THEN END;
  383.     ELSE
  384.         O.Str("Directories.InitDirectories: Cannot find `Oberon4Amiga:paths'!"); O.Ln;
  385.     END;
  386.     startupPath := "Oberon4Amiga:";
  387.     CurrentDir:=This(startupPath);
  388. END InitDirectories;
  389. PROCEDURE 
  390. NoNotify (op: INTEGER; path, name: ARRAY OF CHAR);
  391. END NoNotify;
  392. BEGIN
  393.     notify := NoNotify;
  394.     InitDirectories
  395. END Directories.
  396.